home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / dkbuts.zip / FONT2DAT.BAS < prev    next >
BASIC Source File  |  1991-05-16  |  11KB  |  235 lines
  1. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2. ''  Conversion notes:                                          ''
  3. ''     DEFINT means any untyped variable defaults to INT       ''
  4. ''     GET #1,,IN$ means get from file #1 into IN$ for a length''
  5. ''        of however big IN$ already is.                       ''
  6. ''     COMMAND$ is the command line less the program name. Just''
  7. ''        rewrite the lousy BASIC interpretation of parameters.''
  8. ''     Type ! is a float, & is a long int, # is an 8-byte float''
  9. ''     STRING$(n,c) function returns a string containing 'n'   ''
  10. ''        occurances of the character 'c'.                     ''
  11. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  12. defint a-z
  13. VERSION!=1.02
  14. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  15. ''  Version notes:                                             ''
  16. ''  031491 kjk 1.01 Added count of shapes/character.           ''
  17. ''                  Added option to allow one char per file    ''
  18. ''  FUTURE:         Added some optimization of squares/boxes   ''
  19. ''  050191 aac 1.02 Updated to DKB 2.11 by Aaron A. Collins    ''
  20. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  21. print using "FONT2DAT (c) Koehler 1991 v##.## ";version!
  22. def fnh$(x)=right$("0"+hex$(x),2)
  23. pixel=0      ' 0=Sphere  1=Dot  2=Square  3=Box
  24. map = 1      ' Generate Map file ON by default
  25. cmd$=command$
  26. fils=1
  27. argarg=instr(cmd$,"-M"): if argarg then cmd$=left$(cmd$,argarg-1)+mid$(cmd$,argarg+3):fils=1
  28. argarg=instr(cmd$,"-m"): if argarg then cmd$=left$(cmd$,argarg-1)+mid$(cmd$,argarg+3):fils=1
  29. argarg=instr(cmd$,"-S"): if argarg then cmd$=left$(cmd$,argarg-1)+mid$(cmd$,argarg+3):fils=0
  30. argarg=instr(cmd$,"-s"): if argarg then cmd$=left$(cmd$,argarg-1)+mid$(cmd$,argarg+3):fils=0
  31. argarg=instr(cmd$,"-L"): if argarg then cmd$=left$(cmd$,argarg-1)+mid$(cmd$,argarg+3):map=0
  32. argarg=instr(cmd$,"-l"): if argarg then cmd$=left$(cmd$,argarg-1)+mid$(cmd$,argarg+3):map=0
  33. if left$(cmd$,1)="-" then pixel=val(mid$(cmd$,2,1)):cmd$=mid$(cmd$,4)
  34. if cmd$="" then gosub Usage:end
  35. if pixel>3 then pixel=0
  36. if pixel=0 then print "Generating Spheres";
  37. if pixel=1 then print "Generating Squares";
  38. if pixel=2 then print "Generating Dots";
  39. if pixel=3 then print "Generating Boxes";
  40. if fils=1 then print " to a single file" else print " to multiple files"
  41. fl$=cmd$
  42. if instr(fl$,".") then ext$=mid$(fl$,instr(fl$,".")) : fl$=left$(fl$,instr(fl$,".")-1)
  43. if ext$="" then ext$=".fnt"
  44.  
  45.   open fl$+ ext$  for BINARY as #1
  46.   if fils=1 then open fl$+".dat" for output as #2
  47.   if map=1 then open fl$+".map" for output as #3     ' map graphic char layout
  48.  
  49.   '* Read font header
  50.   in$=chr$(0)
  51.   get #1,,in$
  52.   size&=asc(in$)
  53.   get #1,,in$
  54.   size&=asc(in$)*256+size&
  55.   get #1,,in$
  56.   numchars=asc(in$) : if numchars=0 then numchars=256
  57.   get #1,,in$
  58.   ascoff=asc(in$)
  59.   get #1,,in$
  60.   chxsize=asc(in$)
  61.   get #1,,in$
  62.   chysize=asc(in$)
  63.   get #1,,in$
  64.   chbytes=asc(in$)
  65.   print "'";fl$;ext$;"'";
  66.   print using " is ####, bytes long, ### characters, starting  @ ###";size&;numchars;ascoff
  67.   print using "                     X-size=### , Y-size=### , ### bytes/char";chxsize;chysize;chbytes
  68.   if fils=0 then goto Skip1
  69.   print #2,"{'";fl$;ext$;"'";
  70.   print #2,using " is ####, bytes long, ### characters, starting  @ ### }";size&;numchars;ascoff
  71.   print #2,using "{                     X-size=### , Y-size=### , ### bytes/char }";chxsize;chysize;chbytes
  72.   print #2,
  73.   print #2,"INCLUDE "+chr$(34)+"shapes.dat"+chr$(34)
  74.   print #2,"INCLUDE "+chr$(34)+"colors.dat"+chr$(34)
  75.   print #2,"INCLUDE "+chr$(34)+"textures.dat"+chr$(34)
  76.   print #2,
  77.   print #2,"DECLARE Font_Color = COLOR Red"
  78.   print #2,
  79.   print #2,"DECLARE Font_Texture = TEXTURE"
  80.   print #2,"  COLOR Font_Color"
  81.   print #2,"  AMBIENT 0.3"
  82.   print #2,"  DIFFUSE 0.7"
  83.   print #2,"END_TEXTURE"
  84.   print #2,
  85.  
  86. Skip1:
  87.  
  88.   '* Generate .DAT
  89.   scale#=10/chysize
  90.   empty$=string$(chbytes/chysize,0)
  91.   in$=empty$
  92.   for char=ascoff to ascoff+numchars-1
  93.     if inkey$=chr$(27) then end ' ABORT
  94.     if fils=1 then goto Skip2
  95.     open fl$+".D"+fnh$(char) for output as #2
  96.     print #2,"INCLUDE "+chr$(34)+"shapes.dat"+chr$(34)
  97.     print #2,"INCLUDE "+chr$(34)+"colors.dat"+chr$(34)
  98.     print #2,"INCLUDE "+chr$(34)+"textures.dat"+chr$(34)
  99.     print #2,
  100.     print #2,"DECLARE Font_Color = COLOR Red"
  101.     print #2,
  102.     print #2,"DECLARE Font_Texture = TEXTURE"
  103.     print #2,"  COLOR Font_Color"
  104.     print #2,"  AMBIENT 0.3"
  105.     print #2,"  DIFFUSE 0.7"
  106.     print #2,"END_TEXTURE"
  107.  
  108. Skip2:
  109.  
  110.     print #2,
  111.     print #2,"DECLARE Char_";fnh$(char);" = ";
  112.     if ((char and &h7F) >= 32) and ((char and &h7F) <= 127) then char$="{"+chr$(char)+"}" else char$=""
  113.     if char$="{{}" then char$="{left-curly}"
  114.     if char$="{}}" then char$="{right-curly}"
  115.     if map=1 then print #3,char$
  116.     print #2,char$
  117.     if fils=0 then print #2,using "{                     X-size=### , Y-size=### , ### bytes/char }";chxsize;chysize;chbytes
  118.     print #2,"   OBJECT"
  119.     print #2,"       UNION"
  120.     previous.x$=empty$
  121.     for bity= chysize-1 to 0 step -1
  122.       bitx=0
  123.       get #1,,in$
  124.       char.byte=0
  125.       while bitx< chxsize
  126.     char.byte=char.byte+1
  127.     byte=asc(mid$(in$,char.byte,1))
  128.     previous.byte=asc(mid$(previous.x$,char.byte,1))
  129.     previous.bit=0
  130.     for bit=7 to 0 step -1
  131.       bitx=bitx+1
  132.       if byte and (2^bit) then gosub WriteOn else gosub WriteOff
  133.     next bit
  134.     if pixel=3 then if previous.bit=1 then gosub WriteLeft
  135.       wend
  136.       previous.x$=in$
  137.       if map=1 then print #3,
  138.     next bity
  139.     if map=1 then print #3,string$(chxsize,"-")
  140.     print #2,      "       END_UNION"
  141.     print #2,using "       SCALE <#.####### #.####### #.#######>";scale#;scale#;scale#
  142.     print #2,      "       TEXTURE Font_Texture END_TEXTURE COLOR Font_Color"
  143.     if pixel=0 then print #2,using "       { Spheres = #####, }";spheres
  144.     if pixel=1 or pixel=3 then print #2,using "       { Triangles = #####, }";triangles
  145.     if pixel=2 then print #2,using "       { Dots = #####, }";dots
  146.     total.spheres=total.spheres+spheres     :spheres=0
  147.     total.dots=total.dots+dots          :dots=0
  148.     total.triangles=total.triangles+triangles   :triangles=0
  149.     print #2,      "   END_OBJECT"
  150.     if fils=0 then close #2
  151.   next char
  152.   if fils=1 then print #2,using " { Dataset Total Spheres =#####,   Triangles =#####,   Dots =#####, }";total.spheres;total.triangles;total.dots
  153.   print    using "   Dataset Total Spheres =#####,   Triangles =#####,   Dots =#####,  ";total.spheres;total.triangles;total.dots
  154.   if fils=1 then close #2
  155.   close
  156.   end
  157.  
  158. WriteOn:
  159.   if pixel=3 then if previous.bit=0 then gosub WriteLeft
  160.   if pixel=3 then if (previous.byte and (2^bit))=0 then gosub WriteTop
  161.   previous.bit=1
  162.   if map=1 then print #3,"#";
  163.   if pixel=0 then print #2,using "          SPHERE <## ## 0> 0.5";bitx;bity;
  164.   if pixel=0 then print #2,  " END_SPHERE"
  165.   if pixel=0 then spheres=spheres+1
  166.   if pixel=1 then print #2,using "          TRIANGLE <###.# ###.# 0> <###.# ###.# 0> <###.# ###.# 0>";bitx-.5;bity-.5;bitx+.5;bity+.5;bitx+.5;bity-.5;
  167.   if pixel=1 then print #2,  " END_TRIANGLE"
  168.   if pixel=1 then print #2,using "          TRIANGLE <###.# ###.# 0> <###.# ###.# 0> <###.# ###.# 0>";bitx-.5;bity-.5;bitx+.5;bity+.5;bitx-.5;bity+.5;
  169.   if pixel=1 then print #2,  " END_TRIANGLE"
  170.   if pixel=1 then triangles=triangles+2
  171.   if pixel=2 then print #2,using "          QUADRIC Sphere TRANSLATE<## ## 0> SCALE<0.5 0.5 0.01>";bitx;bity;
  172.   if pixel=2 then print #2,  " END_QUADRIC"
  173.   if pixel=2 then dots=dots+1
  174.   if pixel=3 then print #2,using "    {F}   TRIANGLE <###.# ###.# -0.5> <###.# ###.# -0.5> <###.# ###.# -0.5>"; bitx-.5;bity-.5; bitx+.5;bity+.5; bitx+.5;bity-.5;
  175.   if pixel=3 then print #2,  " END_TRIANGLE"
  176.   if pixel=3 then print #2,using "    {F}   TRIANGLE <###.# ###.# -0.5> <###.# ###.# -0.5> <###.# ###.# -0.5>"; bitx-.5;bity-.5; bitx+.5;bity+.5; bitx-.5;bity+.5;
  177.   if pixel=3 then print #2,  " END_TRIANGLE"
  178.   if pixel=3 then print #2,using "    {B}   TRIANGLE <###.# ###.#  0.5> <###.# ###.#  0.5> <###.# ###.#  0.5>"; bitx-.5;bity-.5; bitx+.5;bity+.5; bitx+.5;bity-.5;
  179.   if pixel=3 then print #2,  " END_TRIANGLE"
  180.   if pixel=3 then print #2,using "    {B}   TRIANGLE <###.# ###.#  0.5> <###.# ###.#  0.5> <###.# ###.#  0.5>"; bitx-.5;bity-.5; bitx+.5;bity+.5; bitx-.5;bity+.5;
  181.   if pixel=3 then print #2,  " END_TRIANGLE"
  182.   if pixel=3 then triangles=triangles+4
  183.   if pixel=3 then if bity=0 then gosub WriteBottom
  184. return
  185.  
  186. WriteOff:
  187.   if pixel=3 then if previous.bit=1 then gosub WriteLeft
  188.   if pixel=3 then if (previous.byte and (2^bit)) then gosub WriteTop
  189.   previous.bit=0
  190.   if map=1 then print #3," ";
  191. return
  192.  
  193. WriteLeft:
  194.   ' generate left side wall of box
  195.   print #2,using "    {l}   TRIANGLE <###.# ###.# -0.5> <###.# ###.#  0.5> <###.# ###.# -0.5>"; bitx-.5;bity-.5; bitx-.5;bity+.5; bitx-.5;bity+.5;
  196.   print #2,  " END_TRIANGLE"
  197.   print #2,using "    {l}   TRIANGLE <###.# ###.# -0.5> <###.# ###.#  0.5> <###.# ###.#  0.5>"; bitx-.5;bity-.5; bitx-.5;bity+.5; bitx-.5;bity-.5;
  198.   print #2,  " END_TRIANGLE"
  199.   triangles=triangles+2
  200. return
  201.  
  202. WriteTop:
  203.   ' generate top of of box
  204.   print #2,using "    {t}   TRIANGLE <###.# ###.#  0.5> <###.# ###.# -0.5> <###.# ###.# -0.5>"; bitx-.5;bity+.5; bitx+.5;bity+.5; bitx-.5;bity+.5;
  205.   print #2,  " END_TRIANGLE"
  206.   print #2,using "    {t}   TRIANGLE <###.# ###.#  0.5> <###.# ###.# -0.5> <###.# ###.#  0.5>"; bitx-.5;bity+.5; bitx+.5;bity+.5; bitx+.5;bity+.5;
  207.   print #2,  " END_TRIANGLE"
  208.   triangles=triangles+2
  209. return
  210.  
  211. WriteBottom:
  212.   ' generate bottom of of box
  213.   print #2,using "    {b}   TRIANGLE <###.# ###.#  0.5> <###.# ###.# -0.5> <###.# ###.# -0.5>"; bitx-.5;bity-.5; bitx+.5;bity-.5; bitx-.5;bity-.5;
  214.   print #2,  " END_TRIANGLE"
  215.   print #2,using "    {b}   TRIANGLE <###.# ###.#  0.5> <###.# ###.# -0.5> <###.# ###.#  0.5>"; bitx-.5;bity-.5; bitx+.5;bity-.5; bitx+.5;bity-.5;
  216.   print #2,  " END_TRIANGLE"
  217.   triangles=triangles+2
  218. return
  219.  
  220. Usage:
  221.   print
  222.   print "Usage:  FONT2DAT [-0123] [-MS] filename[.fnt]"
  223.   print "          -0 = Generate pixels as Spheres <default>"
  224.   print "          -1 = Generate pixels as Squares "
  225.   print "          -2 = Generate pixels as Dots    "
  226.   print "          -3 = Generate pixels as Boxes   "
  227.   print "          -M = Multiple chars/file <default>"
  228.   print "          -S = Single char/file           "
  229.   print "          -L = No char Map List File output <on by default>"
  230.   print
  231.   print "Ex:     FONT2DAT -3 -S CYBER.SET"
  232.   print "        Would create CYBER.Dnn files with box type pixels"
  233.   print "          where 'nn' is the hex ASCII character code."
  234. return
  235.